
;	=======================================================
;
;	REC module for the operators and predicates pertaining
;	to the pushdown list, other than the most important
;	ones already contained in the REC nucleus.  These
;	comprise:
;
;		arithmetic
;
;			+	sum modulo 2**16
;			-	difference modulo 2**16
;			*	product modulo 2**16
;			/	remainder, quotient
;			=	equality
;			~	complement or negative
;			d	decrement, false on zero
;			^	increment
;			N	comparison of top 2 args
;
;		modification of arguments
;
;			H	hex ASCII string to binary
;			[exclm]	binary to hex ASCII string
;			%	restrict argument to one byte
;			\	embed argument in two bytes
;			&	exchange top arguments
;			|	concatinate top arguments
;
;		block movements
;
;			G	fetch a block from memory
;			g	address fetch
;			r	replace address by contents
;			u	incrementing byte fetch
;			y	incrementing word fetch
;			P	put buffer block in memory
;			S	store block in memory
;			s	store into buffer
;			v	incrementing byte store
;			m	move arg to end of PDL space
;			n	recover arg from end of PDL
;
;		generate pointers
;
;			c	reserve block, generate pointer
;			p	put px, py-px on PDL
;			l	put pz on PDL
;			$	form addr of variable cell
;
;	-------------------------------------------------------
;	Version of REC released during the summer school, 1980
;	-------------------------------------------------------
;
;		 PDL86  -  Copyright (C) 1982
;		Universidad Autonoma de Puebla
;		     All Rights Reserved
;
;	     [Harold V. McIntosh, 25 April 1982]
;
;	May 29, 1983 - & exchanges arbitrary arguments
;	May 29, 1983 - ~ discontinued; use m&n instead
;	May 29, 1983 - ~ Complement or Negate top element
;	May 29, 1983 - N for Numerical comparison on PDL
;	July 7, 1983 - $ with char arg gets subroutine addr
;	January 23, 1984 - at comp:, <cmp ax,> is <cmp cx,>
;	=======================================================

;	=======================================================
;	A collection of subroutines for two-byte arithmetic,
;	including loading and storage of the 8080 registers
;	from the pushdown list.
;	=======================================================

;	-------------------------------------------------------
;	Load and store subroutines for 2-byte arithmetic.
;	-------------------------------------------------------

;	Push a one-byte value onto the PDL.  The value to be
;	pushed should be placed on the 8080's stack in the
;	low byte position (say by using <push psw>) before
;	calling PUON.

PUON:	mov	cx,1		;one byte is required
	call	NARG		;close old variable, reserve space
	pop	bp		;source was pushed before calling
	pop	ax
	mov	[bx],al		;store byte, which is low order
	inc	bx		;pointer to next byte
	mov	PY,bx		;close new argument
	jmp	bp

;	Push a two-byte value onto the PDL.  The value to be
;	pushed should be placed on the 8080's stack before
;	calling PUTW.

PUTW:	mov	cx,2		;two bytes are required
	call	NARG		;close old variable, reserve space
	mov	bp,sp
	mov	ax,2[bp]
	mov	[bx],ax		;store low order byte
	inc	bx		;on to high order destination
	inc	bx		;always leave pointer in good condition
	mov	PY,bx		;close top argument
	ret	2

;	(&) Exchange top two arguments, assumed two-byte.

EXCH:	mov	ax,PY
	mov	bx,PX		;org1
	sub	ax,bx		;siz1
	mov	dx,-2[bx]	;org2
	lea	cx,-2[bx]
	sub	cx,dx		;siz2
	cmp	ax,cx
	jnz	XTNE
	jcxz	XTRE
XTEQ:	mov	al,[bx]
	xchg	bx,dx
	mov	ah,[bx]
	mov	[bx],al
	xchg	bx,dx
	mov	[bx],ah
	inc	bx
	inc	dx
	loop	XTEQ
XTRE:	ret
XTNE:	push	cx
	push	dx
	push	bx
	push	ax
	push	dx
	call	NARG
	mov	ax,ds
	mov	es,ax
	cld
	mov	di,bx
	pop	si
	repnz	movs	byte [di],[si]
	pop	cx
	pop	si
	pop	di
	push	di
	repnz	movs	byte [di],[si]
	pop	word ptr [di]
	lea	di,2[di]
	mov	si,PX
	mov	PX,di
	pop	cx
	repnz	movs	byte [di],[si]
	mov	PY,di
	ret

;	Load top three arguments into (cx),(dx),(bx).  In
;	reality so many permutations exist for places to put
;	the arguments as they are taken off the REC stack that
;	they are simply transferred to the 8080 stack, to be
;	popped into the desired registers on return from the
;	corresponding call.  It is assumed that all quantities
;	involved in these transactions are of two bytes.  A
;	sequence of entry points is provided so as to pop off
;	one, two, or three arguments.

THRG:	mov	bx,PX		;get pointer to top argument
THRL:	pop	bp		;enter here if (bx) already loaded
	push	word ptr [bx]
	push	bp
	call	UCL		;pop top argument, load (bx) from px
TWOL:	pop	bp		;continue, or entry for two args
	push	word ptr [bx]
	push	bp
	call	UCL		;pop argument, put px in (bx)
ONEL:	pop	bp		;continue, or entry for one argument
	push	word ptr [bx]
	push	bp
	jmp	UCL		;pop the last argument, quit

;	Load up pointers to top two arguments.

ARGG:	mov	di,PX		;org1
	mov	cx,-2[di]
	jcxz	arge		;no second argument
	mov	ax,PY
	sub	ax,di		;siz1
	mov	bx,cx		;org2
	lea	dx,-2[di]
	mov	cx,dx
	sub	cx,bx		;siz2
	cmp	cx,ax
	jnz	arge		;arguments not same length
	ret
ARGE:	call	rer
ARGS:	call	ARGG
	mov	PX,bx
	mov	PY,dx
	ret

;	-------------------------------------------------------
;	Two-byte arithmetic according to the four operations.
;	-------------------------------------------------------

;	(+)  Add top registers on pdl: <a,b,+> leaves (a+b).
;	The sum is calculated modulo 2**16, no evidence of any
;	overflow remains behind.

SUM:	call	args
	cmp	ax,01
	jz	SUM1
	cmp	ax,02
	jz	SUM2
	call	rer
SUM1:	mov	al,[di]
	or	[bx],al
	ret
SUM2:	mov	ax,[di]
	add	word ptr [bx],ax
	ret

;	(-)  Subtract top from next: <a,b,-> leaves (a-b).
;	Reverse subtraction can be accomplished by exchanging
;	arguments: write <a,b,&,-> to get (b-a).  Subtraction
;	is carried out modulo 2**16; thus -1 = FFFF hex.

DIF:	call	args
	cmp	ax,01
	jz	DIF1
	cmp	ax,02
	jz	DIF2
	call	rer
DIF1:	mov	al,[di]
	xor	[bx],al
	ret
DIF2:	mov	ax,[di]
	sub	word ptr [bx],ax
	ret

;	(*)  Multiply top: <a,b,*> leaves (a*b).  The product
;	is for integer arithmetic, modulo 2**16, and so is not
;	directly suitable for a 32-bit product.

MPY:	call	args
	cmp	ax,01
	jz	MPY1
	cmp	ax,02
	jz	MPY2
	call	rer
MPY1:	mov	al,[di]
	and	[bx],al
	ret
MPY2:	mov	ax,[di]
	mul	word ptr [bx]
	mov	[bx],ax
	ret

;	(/)  Divide top: <a,b,/> leaves rem(a/b), int(a/b).
;	Reverse division is possible by exchanging arguments;
;	thus <b,a,&,/> leaves rem(b/a), int(b/a).  If just
;	the remainder is required, write <a,b,/,L>, while if
;	only the quotient is desired, write <a,b,/,&,L>, and
;	finally, if the order of the remainder and quotient is
;	not satisfactory, they can be exchanged.  The division
;	is unsigned integer division.  It can also be used to
;	split a two-byte word into two parts through division
;	by the corresponding power of two.

DVD:	call	ARGG
	cmp	word ptr [di],0000
	jz	DER
	mov	ax,[bx]
	mov	dx,0000
	div	word ptr [di]
	mov	[di],ax
	mov	[bx],dx
	ret
DER:	call	RER

;	(~)  Complement or Negate the top of the pushdown list.

comp:	mov	bx,PX
	mov	cx,PY
	sub	cx,bx
	cmp	cx,01
	jz	com1
	cmp	cx,02
	jz	com2
	call	rer
com1:	not	byte ptr [bx]
	ret
com2:	neg	word ptr [bx]
	ret

;	(^)  Increment the top of the pushdown list.

INCR:	mov	bx,PX		;pointer to argument
	inc	word ptr [bx]
	ret

;	(d)  Decrement top of PDL if it is not zero; otherwise
;	FALSE, erasing the counter.  Equivalent to ((0=;1-)).

DECR:	mov	bx,PX		;fetch pointer to argument
	sub	word ptr [bx],1		;dec won't work because of c flag
	jb	DCF
	jmp	SKP		;no carry means TRUE
DCF:	jmp	UCL		;when FALSE, erase counter

;	(N) Numerical comparison of top two elements on PDL. <a,b,N>
;	is TRUE if a .LE. b; both arguments are erased irrespective
;	of the result.  Numerical comparison is for integers; for one-
;	byte arguments the comparison is logical.

UCN:	call	args
	cmp	ax,01
	jz	UN1
	cmp	ax,02
	jz	UN2
	call	rer
UN1:	mov	al,[di]
	test	al,[bx]
	jz	UNF
	jmp	UNT
UN2:	mov	ax,[di]
	cmp	ax,[bx]
	jz	UNF
UNT:	jmp	CUCL
UNF:	jmp	UCL

;	-------------------------------------------------------
;	Conversion between binary and hexadecimal ASCII strings
;	-------------------------------------------------------

;	Return if not hexadecimal. A unchanged if not hex, else
;	reduced to binary.

RNH:	cmp	al,'G'		;no hex characters beyond F
	jnb	RH2
	cmp	al,'A'		;hex letters equal A or beyond
	jb	RH1
	sub	al,'7'		;compensate the gap between 9 and A
	ret
RH1:	jmp	RND
RH2:	inc	sp
	inc	sp
	ret

;	Cummulation to convert a hex ASCII string to binary.

HXP:	add	bx,bx		;shift left 4 bits
	add	bx,bx		;
	add	bx,bx		;
	add	bx,bx		;
	or	bl,al		;or in the nibble in the accumulator
	ret

;	(H) Convert a hex ASCII string on the PDL into binary.
;	Whatever the length of the argument, conversion will be
;	made to a two-byte binary number.  Thus, if more than
;	four hex digits are present, the result will be reduced
;	modulo 2**16.  It should be noted that the conversion
;	starts with the first byte of the argument and procedes
;	onward.

HE:	mov	cx,2		;two bytes required for result
	call	OARG		;check if they are available
	mov	bx,PY		;fetch terminal address of string
	mov	byte ptr [bx],(offset ZE)	;zero signals its end
	mov	dx,PX		;fetch beginning of string
	mov	bx,(offset ZE)		;place zero in (bx) to prime conversion
H1:	xchg	bx,dx
	mov	al,[bx]
	xchg	bx,dx		;fetch ASCII character
	inc	dx		;ready for the next one
	or	al,al		;check the terminator byte
	jz	H2		;when end reached, close off argument

	call	RNH		;if not hex digit, forget it all
	call	HXP		;otherwise times 16 plus new digit
	jmp	H1		;repeat the cycle
H2:	xchg	bx,dx		;binary number into (dx)
	mov	bx,PX		;place to store the result
	mov	[bx],dx		;store low byte
	inc	bx		;on to high byte
	inc	bx		;pointer must always be one ahead
	mov	PY,bx		;store terminal address
	jmp	SKP		;TRUE return from predicate

;	([exclm])  Convert a two-byte binary number into an ASCII
;	string.  A one-byte number will also be converted, but
;	into two nibbles rather than four, to serve in some
;	applications where the leading zeroes are not wanted.

HX:	mov	cx,PY
	sub	cx,PX
	cmp	cx,1		;see if it's one byte
	jnz	HS		;if not, continue elsewhere

HN:	mov	cx,2		;two nibble result for 1 byte
	call	OARG		;see that there's that much space
	mov	bx,PX
	mov	dl,[bx]		;load low bit
	jmp	HSI		;
HS:	mov	cx,4		;four nibble result for 2 bytes
	call	OARG		;be sure there's space for it
	mov	bx,PX		;pointer to first byte
	mov	dx,[bx]		;load low byte
	mov	al,dh		;separate high byte first
	call	HSA		;write out left nibble
	mov	al,dh		;high byte again
	call	HSB		;write out right nibble
HSI:	mov	al,dl		;separate low byte
	call	HSA		;write out left nibble
	mov	al,dl		;low byte second trip
	call	HSB		;write out right nibble
	mov	PY,bx		;store end of argument
	ret

HSA:	ror	al,1		;shift byte right four bits
	ror	al,1		;
	ror	al,1		;
	ror	al,1		;
HSB:	and	al,0FH		;mask in right nibble
	add	al,90H		;prepare for some carries from <daa>
	daa			;create gap if nibble beyond 10
	adc	al,40H		;code for @ if we have a letter
	daa			;decide 3 for digit, 4 for letter
	mov	[bx],al		;record the ASCII digit
	inc	bx		;pointer ready for next deposit
	ret

;	-------------------------------------------------------
;	Fetch and store bytes, addresses, and blocks to and fro
;	between the PDL and the memory.  The following chart
;	shows the relation between all the different operators
;	which are available.
;
;				byte	word	block
;				----	----	-----
;
;	replace			-	r	G
;	fetch, nonincement	g	-	-
;	fetch, increment	u	y	-
;
;	store			-	-	S
;	store, increment	-	-	v
;	store w.r.t. limit	-	-	s
;	store into buffer	-	-	P
;
;	variable head cell	-	$	-
;
;	The main operators for saving and fetching variables
;	are G and S.  The remainder were especially chosen
;	on the one hand to scrutinize the memory under REC
;	control, and on the other to give the widest possible
;	latitude in defining variables in applications of REC.
;
;	The following chart shows how to employ variables:
;
;	    'data' n$ S		define 2-byte variable
;	     n$ r		fetch 2-byte variable
;	    'data' ml n$ S	save fixed variable
;	     n$ ryG		fetch fixed variable
;	    'data' n$rs		redefine existing fixed var
;	     kc Lml n$ S	create k-byte buffered variable
;	     kc n$ S		alternative k-byte buffered var
;	    'data' n$r P	redefine buffered variable
;	     n$ ryLyG		fetch buffered variable
;
;	Memory can be examined bytewise with the following
;	combinations:
;
;	    org g		fetch a byte, keep origin
;	    org u		autoincrementing byte fetch
;	    org v		autoincrementing byte store
;	    org (g  ... v:;)	read, modify, store, ready next
;	    o1 o2 (u~...v&:;)	move from o1 to o2
;
;	-------------------------------------------------------

;	(g) (u)  Fetch a byte from memory and leave on PDL. The
;	sequence <org, g> leaves <org, (org)[1 byte]> on PDL.
;	The sequence <org, u> leaves <org+1, (org)[1 byte]> on
;	PDL.

GB:	mov	bx,PX		;/g/ pointer to top argument
	push	word ptr [bx]		;fetch low byte of origin
	jmp	GBJ		;if the origin is not to be incremented
GBI:	mov	bx,PX		;/u/ pointer to arg, which is org
	push	word ptr [bx]		;fetch low byte of origin
	inc	word ptr [bx]
GBJ:	mov	cx,1		;require space for one byte
	call	NARG		;close old arg, check space, open new
	pop	dx		;here's the origin we saved
	xchg	bx,dx
	mov	al,[bx]
	xchg	bx,dx		;fetch the byte there
	mov	[bx],al		;store on the PDL
	inc	bx		;pointer always ready for next byte
	mov	PY,bx		;right deliniter of argument
	ret

;	(y)  Fetch two bytes from memory and leave on PDL.
;	The sequence <org, y> leaves <org+2, (org)[2 bytes]>
;	on PDL.

GW:	mov	bx,PX		;/ / pointer to the argument
	push	word ptr [bx]		;low byte of origin
	jmp	GWJ		;common continuation of gw, gwi
GWI:	mov	bx,PX		;/y/ pointer to the argument
	push	word ptr [bx]		;place low byte in A
	add	word ptr [bx],2		;origin to be incremented by 2
GWJ:	mov	cx,2		;require space for two bytes
	call	NARG		;close old arg, check space, open new
	pop	dx		;now we're ready for that origin
	xchg	bx,dx
	mov	ax,[bx]
	xchg	bx,dx		;fetch the byte sitting there
	mov	[bx],ax		;and store it on PDL
	inc	bx
	inc	bx		;keep the pointer moving along
	mov	PY,bx		;value's finished, store its end
	ret

;	(G)  Fetch a block from memory, leave on PDL.
;	<org,siz, G> leaves (org, ...) on PDL.

GA:	call	CXLD		;load siz into (cx)
	call	OARG		;reuse the argument, but with siz bytes
	mov	bx,PX		;fetch the destination address
	mov	si,[bx]		;but the source address is stored there
	cld
	mov	di,bx
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	mov	PY,di		;(bx) holds the destination terminator
	ret

;	(S)  Store a block forward from the designated memory
;	location.  <'data' org S> stores 'data' starting at
;	org; leaves no residue on the PDL.

SA:	call	CXLD		;fetch destination origin
	mov	di,cx		;save it for a while
	mov	si,PX
	mov	cx,PY
	sub	cx,si
	cld
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	jmp	UCL		;pop the second argument too

;	(v)  Store a block, leaving incremented address.
;	<org,'data' v> leaves org+size['data'] on PDL, stores
;	'data' starting from org.

SAI:	mov	si,PX
	mov	cx,PY
	sub	cx,si		;determine length of data
	call	UCL		;pop top argument, exposing second
	mov	di,[bx]		;(bx) has px, which is destn address
	mov	ax,ds
	mov	es,ax
	mov	ax,si
	add	ax,cx
	cmp	di,ax
	jb	LVB
	cld
	repnz	movs	byte [di],[si]
	mov	[bx],di
	ret
LVB:	std
	add	si,cx
	add	di,cx
	mov	[bx],di
	dec	si
	dec	di
	repnz	movs	byte [di],[si]
	ret

;	(s)  Store into an area of limited size. The sequence
;	<'data' org s> will store 'data' beginning at org+2,
;	supposing that siz('data') is less than or equal to
;	(org, org+1).  In either event no residue is left, but
;	an error notation is generated if the data doesn't fit.
;	No data at all is stored if all will not fit.  If it
;	matters to know how much of the space was used, the
;	operator P should probably be used instead.

LCS:	call	CXLD		;fetch destination origin
	mov	bx,cx		;save it while calling psiz
	mov	si,PX
	mov	cx,PY
	sub	cx,si		;determine length of data
	mov	ax,[bx]		;low byte of capacity
	cmp	ax,cx
	jnb	LST
	call	UCL
	call	RER		;note error, return if it won't fit
LST:	cld
	inc	bx
	inc	bx
	mov	di,bx
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	jmp	UCL		;pop second argument

;	(P)  Store into a buffer and note length.  Used to
;	store data of variable length into an area whose
;	maximum length is fixed.  The buffer has the form
;
;	   /available/used/data/data/.../data/.../end/
;
;	The sequence <'data' org P> will store the data
;	in the buffer beginning at org. (org, org+1) holds
;	the maximum length of data that may be stored in the
;	buffer, (org+2, org+3) is siz('data'), and 'data' is
;	stored from org+4 onward if it will fit.  If it will
;	not, P is a noop and error is set.

UCP:	call	CXLD		;pointer to destination
	mov	bx,cx		;save destination while calling psiz
	mov	si,PX
	mov	cx,PY
	sub	cx,si		;load (cx) with length of data
	inc	cx		;data has to appear two bytes larger
	inc	cx		;to include cell showing its size
	mov	ax,[bx]		;low byte of destination capacity
	inc	bx		;
	inc	bx		;
	cmp	ax,cx
	jnb	UP1
	call	RER		;capacity exceeded: mark error, return
UP1:	dec	cx		;we want to store the true size
	dec	cx		;subtract out the two byte margin
	mov	[bx],cx		;low byte into usage cell
	inc	bx		;just keep moving along
	inc	bx		;ready to start moving data
	cld
	mov	di,bx
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	jmp	UCL		;lift second argument, leave nothing

;	(r)  Replace address on top of pdl by its contents.

IND:	mov	bx,PX		;pointer to top argument
	mov	dx,[bx]		;load low byte
	xchg	bx,dx		;(bx) now has top argument
	mov	ax,[bx]		;low byte of indirect address
	xchg	bx,dx		;address of top argument again
	mov	[bx],ax		;store low indirect byte
	ret

;	($)  Generate the address of the nth cell in the array
;	of variables, which is a block of two-byte addresses.
;	These cells may be used to store data directly - for
;	example counters or addresses - or indirectly through
;	pointers to the actual location of the data.  By giving
;	a one-byte character argument, <'x'$>, the location where
;	the address of subroutine x is stored may be obtained.

VBLE:	mov	bx,PX		;pointer to argument
	mov	cx,PY
	sub	cx,bx
	cmp	cx,2
	jz	VBLF
	mov	cx,2
	call	OARG
	mov	bx,PX
	mov	al,[bx]
	mov	ah,0
	jmp	VBLG
VBLF:	mov	ax,[bx]
VBLG:	add	ax,ax
	add	ax,VRT
	mov	[bx],ax
	add	bx,2
	mov	PY,bx
	ret

;	(l)  Load pz onto PDL.

LCL:	push	PZ		;putw requires arg on 8080 stack
	call	PUTW		;record two-byte argument
	ret			;can't use simply <jmp putw>

;	(m)  Set aside top argument on PDL.  It is moved to the
;	other end of the array reserved for the PDL, which can
;	be used as a temporary storage stack without name.  The
;	mechanism by which pz is moved and the block size is
;	recorded makes this an attractive mechanism to create
;	storage space for REC variables.

LCM:	mov	si,PY
	mov	cx,si
	sub	cx,PX		;get length of top argument
	push	cx
	call	UCL		;pop top argument
	mov	di,PZ		;load destination origin
	std
	dec	si
	dec	di
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	lea	bx,-1[di]
	mov	PZ,bx
	pop	word ptr [bx]		;recover length
	ret

;	(n)  Recover segment which was set aside.

LCN:	mov	cx,(offset ZE)		;there won't be any net length change
	call	NARG		;close old argument, ready for new
	mov	di,bx		;place destination origin in (dx)
	mov	bx,PZ		;place source origin in (bx)
	mov	cx,[bx]		;place length in cx
	lea	si,2[bx]
	cld
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	mov	PY,di		;end of destination is end of argument
	mov	PZ,si		;update pz
	ret

;	(|)  Concatinate the top arguments on the PDL.

CONC:	mov	si,PX
	mov	cx,PY
	sub	cx,si		;get length of top argument
	call	UCL		;pop top argument, set up pntrs to next
	mov	di,dx		;new py is destination
	cld
	mov	ax,ds
	mov	es,ax
	repnz	movs	byte [di],[si]
	mov	PY,di		;record new terminal address
	ret

;	(%)  Restrict multiple-byte argument to one byte.

PE:	mov	ax,PX
	cmp	ax,PY
	jz	PE1		;leave a null argument in peace
	inc	ax		;add one to it
	mov	PY,ax		;store as limit to the argument
PE1:	ret

;	(\)  Embed a single byte in a pair.

IP:	mov	cx,2		;we want to have two bytes
	call	OARG		;verify that that much space remains
	mov	bx,PX		;pointer to argument
	inc	bx		;pass over first byte
	mov	byte ptr [bx],(offset ZE)	;make high byte zero
	inc	bx		;pass on to next byte
	mov	PY,bx		;record end of argument
	ret

;	(p)  Put px and siz on the pushdown list.

GXS:	mov	dx,PX
	mov	bx,PY
	mov	cx,bx
	sub	cx,dx		;calculate length of top argument
	push	cx		;put length on 8080 stack
	push	dx		;put origin on 8080 stack
	call	PUTW		;put top of 8080 stack on REC PDL
	call	PUTW		;put the next item there too
	ret			;can't combine <call, ret> into <jmp>

;	(c) Reserve a block on the pushdown list. <n,c> creates
;	a block of length n, and puts n-2 at the front of the
;	block as a size indicator.  Then, if n .ge. 2, it will
;	be there as a length indicator for a buffer.   <=====maybe change this?

BLOK:	mov	bx,PX		;pointer to argument
	mov	cx,[bx]		;fetch the argument
	mov	[bx],cx		;store header
	sub	word ptr [bx],2
	call	OARG		;is there enough space to reuse arg?
	mov	PY,bx		;increment in (bx), it goes into py
	push	PX		;px has origin of block just formed
	call	PUTW		;record block origin as new argument
	ret			;can't replace <call putw, ret> by jmp

;	Load a single variable into (cx) from the pushdown
;	list.  No register is sure to be preserved.

CXLD:	mov	bx,PX		;pointer to argument
	mov	cx,[bx]		;fetch low order byte
	jmp	UCL		;erase argument [(cx) is unchanged]

;	Load register pair (dx) from the pushdown list.
;	(cx) will be preserved, (bx) not.

DXLD:	mov	bx,PX		;pointer to argument
	push	word ptr [bx]		;fetch word
	call	UCL		;erase argument
	pop	dx		;restore (dx) since UCL modified it
	ret

;	(=)  Test the two top arguments on the pushdown list
;	for equality.  The arguments may be of any length, but
;	will be equal only when of the same length and composed
;	of the same sequence of bytes. The top argument will be
;	popped whatever the outcome, but when equality is true
;	both will be popped.

EQL:	mov	di,PX		;under argument
	mov	cx,PY
	sub	cx,di		;obtain length of top argument
	call	UCL		;lift top argument
	mov	si,PX
	mov	bx,PY
	sub	bx,si
	cmp	bx,cx		;compare lengths
	jnz	EQF
	cld
	mov	ax,ds
	mov	es,ax
	repz	cmps	byte [di],[si]
	jnz	EQF
	jmp	CUCL		;both agree, erase second arg, TRUE
EQF:	ret			;disagree so FALSE

;	-------------------------------------------------------
;
;	Some of the service routines which are likely to be
;	external references in other modules are:
;
;		puon	push one byte on PDL
;		putw	push address on PDL
;		thrl	load  three arguments onto 8080 stack
;		twol	load two arguments onto 8080 stack
;		onel	load one argument onto 8080 stack
;		bcld	load (cx) from PDL, pop PDL
;		deld	load (dx) from PDL, pop PDL
;
;	-------------------------------------------------------

	END

